home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1997 September / Macworld (1997-09).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / UserCode / stringListSnips.tcl < prev    next >
Text File  |  1996-08-15  |  2KB  |  73 lines
  1. # Bob Alkire
  2. # Interval Research Corp.
  3. # Other useful code snippets
  4. # substitute string
  5. # in place replaces the characters in str from position "from" to position
  6. # "to" with "rep"
  7.  
  8. proc substituteString {str from to rep} {
  9.         upvar $str lstr
  10.         set s [string range $lstr 0 [expr $from - 1]]
  11.         append s $rep
  12.         append s [string range $lstr [expr $to + 1] end]
  13.         set lstr $s
  14.         }
  15. # stringTail
  16. # return n characters from the end of string to the end of the string
  17.  
  18. proc stringTail {n str} {
  19.         set len [string length $str]
  20.         return [string range $str [expr $len - $n] end]
  21.         }
  22. # extractList
  23. # return the pos'th item from theList while removing the item from theList
  24. proc extractList {theList pos} {
  25.         upvar $theList lst
  26.         if {$pos < 0} {return ""}
  27.         set extracted [lindex $lst $pos]
  28.         set last [expr [llength $lst] - 1]
  29.         if {$pos == 0} then {
  30.                 set lst [lrange $lst 1 end]
  31.                 } elseif {$pos == $last} then {
  32.                         set lst [lrange $lst 0 [expr $last - 1]]
  33.                         } else {
  34.                                 set lst [concat [lrange $lst 0 [expr $pos -
  35. 1]] [lrange $lst [expr $pos + 1] end]]
  36.                                 }
  37.         return $extracted
  38. }
  39. # uniqueList
  40. # return a new list with all duplicate items removed from theList
  41. proc uniqueList {theList} {
  42.         set last {}
  43.         set newList {}
  44.         foreach item [lsort $theList] {
  45.                 if {$last != $item} {set last $item; lappend newList $last}
  46.                 }
  47.         return $newList
  48.  }
  49.  
  50. # diffList
  51. # return a new list that is the set of items not in list1 and list2
  52.  
  53. proc diffList {list1 list2} {
  54.         set diff {}
  55.         foreach item $list1 {
  56.                 if {[lsearch $list2 $item] == -1} {lappend diff $item}
  57.                 }
  58.         return $diff
  59. }
  60.  
  61. # sliceList
  62. # theList must be a list of lists
  63. # returns a new list that is made up of a list of the pos'th item in each
  64. list of theList
  65. # example sliceList {{a b c} {d e f} {x y z}} 1 returns b e y
  66. proc sliceList {theList pos} {
  67.         set newList {}
  68.         foreach item $theList {
  69.                 lappend newList [lindex $item $pos]
  70.                 }
  71.         return $newList
  72. }
  73.